home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / appPaths.tcl < prev    next >
Encoding:
Text File  |  2000-12-19  |  12.4 KB  |  428 lines
  1. #  AlphaTcl - core Tcl engine
  2.  
  3. namespace eval app {}
  4.  
  5. proc app::ensureRunning {sig {in_front 0}} {
  6.     # See if a process w/ any of the acceptable 
  7.     # sigs already running.
  8.     if {[app::isRunning [list $sig] name]} {
  9.         if {$in_front} {switchTo '$sig'}
  10.         return $name
  11.     }
  12.     if {[catch {nameFromAppl $sig} name]} {
  13.         alertnote "Can't find app w/ sig '$sig'.\
  14.           Try rebuilding your desktop or changing your helper apps."
  15.         error ""
  16.     }
  17.     if {![file exists $name]} {
  18.         alertnote "Sig '$sig' is mapped to '$name', which doesn't\
  19.           exist. Try changing your helper apps."
  20.         error ""
  21.     }
  22.     # Launch the app
  23.     if {$in_front} {
  24.         launch -f $name
  25.     } else {
  26.         launch $name
  27.     }
  28.     hook::callAll launch $sig
  29.     return $name
  30. }
  31.  
  32. # Switch to 'sig', launching if necesary
  33. proc app::launchFore {sig} {
  34.     app::ensureRunning $sig 1
  35. }
  36.  
  37. # Ensure that the app is at least running in the background.
  38. proc app::launchBack {sig} {
  39.     app::ensureRunning $sig 0
  40. }
  41.  
  42. proc app::launchAnyOfThese {sigs sig {prompt "Please locate the application:"}} {
  43.     app::launchBackSigs $sigs $sig $prompt 0
  44. }
  45. proc app::launchElseTryThese {sigs sig {prompt "Please locate the application:"}} {
  46.     app::launchBackSigs $sigs $sig $prompt 1
  47. }
  48.  
  49. # Check to see if any of the 'sigs' is running. If so, return its name.
  50. # Otherwise, attempt to launch the file named by 'sig'.
  51. proc app::launchBackSigs {sigs sig {prompt "Please locate the application:"} {running_first 1} } {
  52.     upvar \#0 $sig theSig
  53.     if {$running_first || ![info exists theSig] || [catch {nameFromAppl [set theSig]}]} {
  54.     app::setRunningSig $sigs $sig
  55.     app::getSig $prompt $sig
  56.     }
  57.     return [app::launchBack [set theSig]]
  58. }
  59.  
  60. proc app::getSig {prompt sig} {
  61.     upvar \#0 $sig theSig
  62.     if {[catch {nameFromAppl [set theSig]}]} {
  63.     set theSig [getFileSig [getfile $prompt]]
  64.     prefs::modified $sig
  65.     }
  66. }
  67.  
  68. proc app::setRunningSig {sigs sig} {
  69.     upvar \#0 $sig theSig
  70.     if {[app::isRunning $sigs name s]} {
  71.     if {![info exists theSig] || ($s != [set theSig])} {
  72.         set    theSig $s
  73.         prefs::modified $sig
  74.     }
  75.     return 1
  76.     }
  77.     return 0
  78. }
  79.  
  80. ## 
  81.  # -------------------------------------------------------------------------
  82.  # 
  83.  # "app::runScript" --
  84.  # 
  85.  #  Generic run script handler.  Will prompt for the location of your
  86.  #  application if necessary, run in fore/background, show a log of
  87.  #  the result etc.  See latexComm.tcl or diffMode.tcl for examples
  88.  #  of the necessary array entries.
  89.  #  
  90.  #  3 variables must be defined: ${op}Sig is a variable whose
  91.  #  value is the signature of the application the user has selected
  92.  #  to carry out this operation (or the path of an executable, if
  93.  #  'exec' is possible), ${op}AppSignatures is an array of all
  94.  #  possible name/signature pairs currently known, and ${op}AppScripts
  95.  #  are the scripts for each of those signatures.
  96.  #  
  97.  #  'flags' are additional flags to pass to the application
  98.  #  'depth' says how many levels of hierarchy Alpha should backup
  99.  #  before calling the application for a given file.  If depth is
  100.  #  not an integer, it can be the actual path prefix up to which
  101.  #  Alpha should backup.  'depth' isn't relevant to all applications
  102.  #  
  103.  #  Modified from original evalTeXScript in latex mode.
  104.  #  
  105.  #  'runAppInBackground' now takes any of three values:
  106.  #  0: run in foreground
  107.  #  1: run in background if possible, but we want to capture the output
  108.  #     of the process, so we may need to run in foreground.
  109.  #  2: force to run in background (and therefore ignore the output of
  110.  #  the process).
  111.  #     
  112.  #  The '1' value is useful for many calls such as diff, cvs, etc in
  113.  #  which on MacOS we will use apple-events and can therefore run in
  114.  #  the background, but on Unix/Windows we can't run with 'exec ... &'
  115.  #  because we won't be able to capture the result.  Since these tools
  116.  #  are command line tools on Unix/Windows, running in the foreground is
  117.  #  effectively running in the background.
  118.  # -------------------------------------------------------------------------
  119.  ##
  120. proc app::runScript {opp prompt filename {runAppInBackground 0} {showLog 0} {flags ""} {depth ""} {isInDir 0}} {
  121.     if {[llength $opp] > 1} {
  122.     set sigIn [lindex $opp 0]
  123.     set op [lindex $opp 1]
  124.     global $sigIn
  125.     set opVar "${sigIn}(${op}Sig)"
  126.     } else {
  127.     set op $opp
  128.     global ${op}Sig 
  129.     set opVar "${op}Sig"
  130.     }
  131.     global ${op}AppSignatures ${op}AppScripts nonInteractiveApps
  132.     
  133.     set supportedApps [array names ${op}AppSignatures]
  134.     set sigs ""
  135.     foreach app $supportedApps { eval lappend sigs [set ${op}AppSignatures($app)] }
  136.     set longPrompt "Please locate a $prompt."
  137.     if { [catch {app::launchAnyOfThese $sigs $opVar $longPrompt} appname] } {
  138.     error "bug in 'app::launchAnyOfThese' : $appname"
  139.     }
  140.     set sig [set $opVar]
  141.     set quotedSig "'[string trim $sig {'}]'"
  142.     if {!$runAppInBackground} { switchTo $quotedSig }
  143.     if {[file exists $sig]} {
  144.     global tcl_platform
  145.     set stream 1
  146.     # Windows Tcl 8.0 has some fileevent bugs
  147.     if {$tcl_platform(platform) == "windows" && [info tclversion] < 8.1} {
  148.         set stream 0
  149.     }
  150.     # Some apps we never wish to capture stdout/stderr
  151.     if {[info exists nonInteractiveApps]} {
  152.         if {[lsearch -exact $nonInteractiveApps $op] != -1} {
  153.         set stream 0
  154.         set runAppInBackground 2
  155.         }
  156.     }
  157.     if {$stream && $showLog} {
  158.         global mode
  159.         set win [new -n "* $op log *" -m $mode -text "File: $filename\n" -shell 1]
  160.         if {$filename != ""} {
  161.         set olddir [pwd]
  162.         if {$depth != ""} {
  163.             if {[is::UnsignedInteger $depth]} {
  164.             set path [file dirname $filename]
  165.             set filename [file tail $filename]
  166.             while {[incr $depth -1] >= 0} {
  167.                 # currently win/unix specific path delimiter
  168.                 set filename "[file tail $path]/$filename"
  169.                 set path [file dirname $path]
  170.             }
  171.             cd $path
  172.             } else {
  173.             cd $depth
  174.             # $filename is assumed either to be a full
  175.             # path or already backed up to the correct level.
  176.             if {[file::pathStartsWith $filename $depth]} {
  177.                 set filename [string range $filename [expr {[string length $depth] +1}] end]
  178.             }
  179.             }
  180.         } else {
  181.             cd [file dirname $filename]
  182.             set filename [file tail $filename]
  183.         }
  184.         set filename [eval file join [file split $filename]]
  185.         app::setupInput "\"$sig\" $filename $flags" $win
  186.         cd $olddir
  187.         } else {
  188.         app::setupInput "\"$sig\" [file tail $filename] $flags" $win
  189.         }
  190.         set res ""
  191.     } else {
  192.         # We need the output so we actually have to run 'in the foreground'.
  193.         if {$runAppInBackground == 1} { set runAppInBackground 0 }
  194.         if {$filename != ""} {
  195.         set olddir [pwd]
  196.         if {$isInDir} {
  197.             cd $filename
  198.             if {$runAppInBackground} {
  199.             set err [catch {eval [list exec $sig] $flags &} res]
  200.             } else {
  201.             set err [catch {eval [list exec $sig] $flags} res]
  202.             }
  203.             cd $olddir
  204.         } else {
  205.             cd [file dirname $filename]
  206.             if {$runAppInBackground} {
  207.             set err [catch {eval [list exec $sig [file tail $filename]] $flags &} res]
  208.             } else {
  209.             set err [catch {eval [list exec $sig [file tail $filename]] $flags} res]
  210.             }
  211.             cd $olddir
  212.         }
  213.         } else {
  214.         if {$runAppInBackground} {
  215.             set err [catch {eval exec [list $sig] $flags &} res]
  216.         } else {
  217.             set err [catch {eval exec [list $sig] $flags} res]
  218.         }
  219.         }
  220.         if {$runAppInBackground} {
  221.         message "Application running in background."
  222.         return
  223.         }
  224.         if {[expr {($showLog + $err) > 1}]} {
  225.         global mode
  226.         new -n "* $op log *" -m $mode -info "File: $filename\n$res"
  227.         }
  228.         if {$err} {
  229.         beep
  230.         message "Run completed abnormally."
  231.         } else {
  232.         message "Run completed successfully."
  233.         }
  234.     }
  235.     
  236.     return $res
  237.     } else {
  238.     foreach app $supportedApps { 
  239.         if {[lsearch -exact [set ${op}AppSignatures($app)] $sig] >= 0} {
  240.         foreach script [set ${op}AppScripts($app)] {
  241.             set res [eval $script]
  242.         }
  243.         return $res
  244.         } 
  245.     }
  246.     }
  247.     beep
  248.     alertnote "Sorry, no support for your $prompt."
  249.     return
  250. }
  251.  
  252. proc app::setupInput {cmd win} {
  253.     global catSig
  254.     app::getSig "Please find your 'cat' application" catSig
  255.     insertText -w $win $cmd "\n"
  256.     set pipe [open "| \"$catSig\"" r+]
  257.     fconfigure $pipe -buffering none
  258.     fileevent $pipe readable [list app::handleErrorInput $win $pipe 1]
  259.     set output [open "|$cmd 2>@ $pipe" r]
  260.     fileevent $output readable [list app::handleStdoutInput $win $output $pipe]
  261. }
  262.  
  263. proc app::handleErrorInput {w f {err 1}} {
  264.     set data [gets $f]
  265.     if {[string length $data] > 0} {
  266.     goto [maxPos -w $w]
  267.     insertText -w $w $data "\n"
  268.     update
  269.     }
  270. }
  271.  
  272. proc app::handleStdoutInput {w output err} {
  273.     if {[eof $output]} {
  274.     fileevent $output readable ""
  275.     catch {close $output}
  276.     fileevent $err readable ""
  277.     #catch flush $err
  278.     catch {close $err}
  279.     goto [maxPos -w $w]
  280.     insertText -w $w "\nDone\n"
  281.     winReadOnly $w
  282.     }
  283.     # If this fails, the process must have finished, and the pipe closed.
  284.     if {![catch {gets $output} data]} {
  285.     if {[string length $data] > 0} {
  286.         goto [maxPos -w $w]
  287.         insertText -w $w $data "\n"
  288.         update
  289.     }
  290.     }
  291. }
  292.  
  293. proc app::handleInput {w f {err 0}} {
  294.     # Delete handler if input was exhausted.
  295.     if {[eof $f]} {
  296.     fileevent $f readable {}
  297.     close $f
  298.     return
  299.     }
  300.  
  301.     set data [read $f]
  302.  
  303.     if {[string length $data] > 0} {
  304.     goto [maxPos -w $w]
  305.     insertText -w $w $data
  306.     }
  307. }
  308.  
  309.  
  310. ## 
  311.  # -------------------------------------------------------------------------
  312.  # 
  313.  # "app::isRunning" --
  314.  # 
  315.  #  Is an app with one of the given sigs running.  Set the global $sig
  316.  #  to the name of that thing if it is
  317.  #  
  318.  #  {"Finder" "MACS" 978944 182209 }
  319.  #  
  320.  #  Much improved by Vince to avoid scanning the processes list one at a
  321.  #  time.
  322.  #  
  323.  # -------------------------------------------------------------------------
  324.  ##
  325. proc app::isRunning {sigs {n ""} {s ""}} {
  326.     if {$n != ""} {upvar $n name}
  327.     if {$s != ""} {upvar $s sig}
  328.     if {[info tclversion] < 8.0} {
  329.     return [regexp "\"(\[^\"\]+)\" \"([join [quote::Regfind [quote::Regfind $sigs]] |])\" " \
  330.       [processes] "" name sig]
  331.     } else {
  332.     global alpha::platform
  333.     if {$alpha::platform == "alpha"} {
  334.         foreach ss $sigs {
  335.         foreach p [processes] {
  336.             if {[lindex $p 1] == $ss} {
  337.             set sig $ss
  338.             set name [lindex $p 0]
  339.             return 1
  340.             }
  341.         }
  342.         }
  343.     } else {
  344.         foreach ss $sigs {
  345.         if {[string length $ss] > 4 && [file exists $ss]} {
  346.             set sig $ss
  347.             set name $ss
  348.             return 1
  349.         }
  350.         }
  351.     }
  352.     }
  353.     return 0
  354. }
  355.  
  356. ## 
  357.  # -------------------------------------------------------------------------
  358.  # 
  359.  # "app::registerMultiple" --
  360.  # 
  361.  #  Does the dirty work so a mode can use different icons for its menu
  362.  #  according to which application a particular user has selected for
  363.  #  that mode.  The arguments are as follows:
  364.  #  
  365.  #  type - a prefix such as 'java' which is used to create variables
  366.  #         such as 'javaSig' 'javaMenu'
  367.  #  creators - the list of recognised creators (1st is default)
  368.  #  icons - the list of icon resources
  369.  #  menurebuild - the procedure which is used to rebuild the mode menu
  370.  #  
  371.  #  here's an example:
  372.  #  
  373.  #    app::registerMultiple java [list Javc WARZ] \
  374.  #      [list •140 •285] rebuildJavaMenu
  375.  #      
  376.  #  of course the rebuild procedure must use the correct icon like this:
  377.  #  
  378.  #    proc rebuildJavaMenu {} {
  379.  #        global javaMenu
  380.  #        menu -n $javaMenu -p javaMenuProc {
  381.  #        }
  382.  #    }
  383.  #    
  384.  #    Note: this procedure ensures the menu is created the first time it
  385.  #    is called.
  386.  # --Version--Author------------------Changes-------------------------------
  387.  #    1.0     <vince@santafe.edu> original
  388.  # -------------------------------------------------------------------------
  389.  ##
  390. proc app::registerMultiple {type creators icons menurebuild} {
  391.     global ${type}Sig multiApp
  392.     if {![info exists ${type}Sig]} {
  393.     set ${type}Sig [lindex $creators 0]
  394.     }
  395.     set multiApp($type) [list $creators $icons $menurebuild]
  396.     app::multiChanged ${type}
  397.     trace variable ${type}Sig w [list app::multiChanged $type]
  398. }
  399.  
  400. ## 
  401.  # -------------------------------------------------------------------------
  402.  # 
  403.  # "app::multiChanged" --
  404.  # 
  405.  #  Utility procedure used by the above.  No need to call it manually.
  406.  # -------------------------------------------------------------------------
  407.  ##
  408. proc app::multiChanged {type args} {
  409.     global ${type}Menu ${type}Sig multiApp
  410.     # remove old menu
  411.     catch {removeMenu [set ${type}Menu]}
  412.     # update the icon according to signature
  413.     set info $multiApp($type)
  414.     if {[set i [lsearch -exact [lindex $info 0] [set ${type}Sig]]] == -1} {
  415.     set i 0
  416.     }
  417.     set ${type}Menu [lindex [lindex $info 1] $i]
  418.     # rebuild the menu
  419.     eval [lindex $multiApp($type) 2]
  420.     # insert the new menu
  421.     insertMenu [set ${type}Menu]
  422. }
  423.  
  424.  
  425.  
  426.  
  427.  
  428.